home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / intrfc4.arc / HASH.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-23  |  3KB  |  89 lines
  1. unit hash;
  2.  
  3. interface
  4.  
  5.   uses util,globals;
  6.  
  7.   procedure build_list(var obj_list:list_ptr;
  8.                          buffer:byte_array_ptr;
  9.                          hash_table:hash_ptr);
  10.  
  11.   procedure add_unit(obj:obj_ptr; info:unit_ptr);
  12.  
  13. implementation
  14.  
  15.   procedure build_list(var obj_list:list_ptr;
  16.                          buffer:byte_array_ptr;
  17.                          hash_table:hash_ptr);
  18.   var
  19.     i,j,t:word;
  20.     current,new_entry : list_ptr;
  21.     obj : obj_ptr;
  22.   begin
  23.     new(obj_list);
  24.     with obj_list^ do
  25.     begin
  26.       offset := $ffff;     { set up a sentinel record }
  27.       next := nil;
  28.     end;
  29.  
  30.     with hash_table^ do
  31.       for i := 0 to byte_len div 2 do
  32.         if table[i] <> 0 then
  33.         begin
  34.           t := table[i];
  35.           repeat
  36.             current := obj_list;
  37.             while t > current^.offset do
  38.               current := current^.next;
  39.             new(new_entry);
  40.             new_entry^ := current^;
  41.             current^.offset := t;
  42.             current^.hash := i;
  43.             current^.next := new_entry;
  44.              obj := add_offset(buffer,t);
  45.              { get the next object... }
  46.             t := obj^.next_obj;
  47.           until t = 0;
  48.         end;
  49.   end;
  50.  
  51.   procedure add_unit(obj:obj_ptr; info:unit_ptr);
  52.   var
  53.     size,total:word;
  54.     header:^header_rec;
  55.     unit_obj:obj_ptr;
  56.   begin
  57.     if unit_list[info^.unit_number] <> nil then
  58.       exit;
  59.     new(unit_list[info^.unit_number]);
  60.     with unit_list[info^.unit_number]^ do
  61.     begin
  62.       name := obj^.name;
  63.       obj_list := nil;
  64.       size := read_file(obj^.name+'.tpu',pointer(buffer));
  65.       if buffer = nil then
  66.         size := read_file(uses_path+obj^.name+'.tpu',pointer(buffer));
  67.       if (buffer = nil) and got_tpl then
  68.       begin
  69.         header := pointer(tpl_buffer);
  70.         total := 0;
  71.         repeat
  72.           unit_obj := add_offset(header,header^.ofs_this_unit);
  73.           if unit_obj^.name = obj^.name then
  74.           begin
  75.             buffer := pointer(header);
  76.             exit;
  77.           end;
  78.           size := roundup(header^.sym_size,16)
  79.                  +roundup(header^.code_size,16)
  80.                  +roundup(header^.reloc_size,16)
  81.                  +roundup(header^.const_size,16);
  82.           total := total+size;
  83.           header := add_offset(header,size);
  84.         until total >= tpl_size + 16;
  85.         writeln('Warning:  Can''t find unit ',obj^.name);
  86.       end;
  87.     end;
  88.   end;
  89. end.